#!/usr/bin/perl

# CPAN Modules
use Audio::MPD;
use MLDBM qw( DB_File Storable );
use WebService::LastFM::SimilarArtists;
use XML::RSS;
use LWP::Simple;

# Perl Core Modules
use POSIX qw( setsid );
use Storable qw( dclone );
use Encode;
use Data::Dumper;

use strict;

# Begin User Configuration

# Audio::Scrobbler included at end of script
my %lastfm_submit = ( 
    username => 'username',
    password => 'password',
    #progname => 'lsd',      # 'tst' is what we "should" use
    progname => 'tst',
    verbose  => 0
);

my %lastfm_similar = (
    minmatch => 85,
    cache_time => '1 week',
    cache_dir  => '/tmp/mpdhelper/lastfm'
);    

my $mpd_host          = "localhost";
my $mpd_port          = 6600;
my $daemonize         = 0; # Make it a daemon? Not great for debugging
my $lastfm_buddies    = 1; # Make individual playlists for lastfm buddies?
my $playlist_update   = 300; # How often to update playlists (in seconds)
my @friends           = qw( cmauch kensanata codemac wizzomafizzo );
my $playlist_dir      = "$ENV{ 'HOME' }/dotfiles/mpd/playlists";
my $datafile          = "$ENV{ 'HOME' }/dotfiles/mpd/external.db";

# Stop editing!

my ( $currentsong, $currentartist, $seconds, $percent, $entry, $length );
my ( $last_artist, $last_album, $last_title, $last_length, $gosa, $gobuds, @lastfmqueue );

my $pidfile            = "/tmp/mpdhelper.pid";
my $filter             = "Played|Score|Rank|Timestamp";
my $played50_playlist  = "$playlist_dir/Top50_Played.m3u";
my $scored50_playlist  = "$playlist_dir/Top50_Scores.m3u";
my $ranked50_playlist  = "$playlist_dir/Top50_Ranked.m3u";
my $last50_playlist    = "$playlist_dir/Last50_Played.m3u";
my $add50_playlist     = "$playlist_dir/Last50_Added.m3u";
my $lastfm_similar     = "$playlist_dir/LastFM_Similar.m3u";
my $lastfm_rolling     = "$playlist_dir/LastFM_Rolling.m3u";
my $lastfm_friends     = "$playlist_dir/LastFM_Friends.m3u";
my $lastfm_base_url    = "http://ws.audioscrobbler.com/1.0/user/";
my $lastfm_base_suffix = "/recenttracks.rss";

# Check for commandline args
&checkargs( @ARGV ) if @ARGV;

# Create a Last.FM Similar Artist configuration
my $sa = WebService::LastFM::SimilarArtists->new( \%lastfm_similar );

# Make me a Daemon!
if ( $daemonize ) {
    die( "Daemon looks like it's running, delete $pidfile to unlock ") if ( -e $pidfile );
    chdir '/' or die "Can't chdir to /: $!";
    umask 0;
    open STDIN,  '/dev/null'      or die "Can't read /dev/null: $!";
    open STDOUT, ">/dev/null" or die "Can't write to /dev/null: $!";
    open STDERR, ">/dev/null" or die "Can't write to /dev/null: $!";
    defined( my $pid = fork ) or die "Can't fork: $!";
    open( PIDFILE, "> $pidfile" );
    print PIDFILE $pid;
    close PIDFILE;
    exit if $pid;
    setsid or die "Can't start a new session: $!";
}
$gosa   = 0;   # Okay to submit to lastfm.  Flag true when we've submitted.
$gobuds = 0;   # Okay to grab LastFM Friends info, Flag true after we've grabbed
$entry  = 1;   # So we dont muck with current when entering loop

while ( 1 ) { # Main Loop
    sleep 1;

    # Yes nasty, but Audio::MPD does not seem to update state info 
    my $mpd  = Audio::MPD->new( $mpd_host, $mpd_port );
    if (! $mpd->is_connected )        { sleep 10; next }
    if ( $mpd->{'state'} eq 'stop' )  { sleep 10; next }
    if ( $mpd->{'state'} eq 'pause' ) { sleep 10; next }

    my %songinfo = $mpd->get_song_info;
    my $current = $mpd->get_time_info;

    # Submit to scrobbler at 240 seconds or at 50% done.
    if ( ( ( ( $seconds > 240 ) or ( $current->{ 'percentage' } > 50 ) 
           ) and ( $current->{ 'seconds_total' } > 30  ) 
         ) and ( ! $gosa ) and ( ! $entry ) ) {
       
        # Last.FM Submission info
        my %submitinfo = (
            artist => %songinfo->{'Artist'},
            album  => %songinfo->{'Album'},
            title  => %songinfo->{'Title'},
            length => $current->{ 'seconds_total' }
            # Songs with a duration of less than 30 seconds should not be submitted.
        );
        push ( @lastfmqueue, lastfm_submit( \%submitinfo ) ); # Push entry into submission queue.
        my @newqueue = &lastfm_flush( @lastfmqueue );         # Call queue clearer, which returns a new queue (if at all)
        undef @lastfmqueue;                                   # Clear old queue
        @lastfmqueue = @newqueue;                             # And cycle queues

        $gosa = 1;                                            # Block sucessive queue attempts until next song played.
        
    }

    # Run playlist updater every X seconds
    if ( $seconds > $playlist_update ) {
        &update_playlists( %songinfo->{ 'Artist' } );
        $seconds = 0;
    }

    if ( $currentsong eq %songinfo->{ 'Title' } ) {

        # Song is the same, update percentage count and last artist info.
        $percent = $current->{ 'percentage' };

        $last_artist = %songinfo->{ 'Artist' };
        $last_album  = %songinfo->{ 'Album' };
        $last_title  = %songinfo->{ 'Title' };

        $seconds++;
      next;

    } else {

        # Song changed, lets do something!

        my $artist = $last_artist;
        my $album  = $last_album;
        my $title  = $last_title;
            
        tie my %layered, 'MLDBM', $datafile;
        my $artistref = $layered{ $artist };

        # If percent played is greater than 20, go ahead and increment play counters.
        if ( $percent > 20 ) { 
            $artistref->{ 'Played' }++;
            $artistref->{ $album }{ 'Played' }++;
            $artistref->{ $album }{ $title }{ 'Played' }++;

            # Record played time
            push( @{ $artistref->{ 'Timestamp'} }, time() );
            push( @{ $artistref->{ $album }{ 'Timestamp'} }, time() );
            push( @{ $artistref->{ $album }{ $title }{ 'Timestamp'} }, time() );

            # Pop off 20th item in last played time (to keep database a reasonable size)
            pop( @{ $artistref->{ 'Timestamp'} } ) if ( scalar @{ $artistref->{ 'Timestamp'} } eq 20 );
            pop( @{ $artistref->{ $album }{ 'Timestamp'} } ) if ( scalar @{ $artistref->{ $album }{ 'Timestamp'} } eq 20 );
            pop( @{ $artistref->{ $album }{ $title }{ 'Timestamp'} } ) if ( scalar @{ $artistref->{ $album}{ $title }{ 'Timestamp'} } eq 20 );
            
        }

        # Because of time lapse between updates.
        if ( $percent > 98 ) { 
            $percent = 100;
        }

        # Dereferences
        my $playcount_artist = $artistref->{ 'Played' };
        my $playcount_album  = $artistref->{ $album }{ 'Played' };
        my $playcount_song   = $artistref->{ $album }{ $title }{ 'Played' };

        my $score_artist     = $artistref->{ 'Score' };
        my $score_album      = $artistref->{ $album }{ 'Score' };
        my $score_song       = $artistref->{ $album }{ $title }{ 'Score' };

        # Yes, I stole amarok's scoring system
        my $scored_artist    = ( ( $score_artist * $playcount_artist ) + $percent ) / ( $playcount_artist + 1 );
        my $scored_album     = ( ( $score_album  * $playcount_album  ) + $percent ) / ( $playcount_album + 1 );
        my $scored_song      = ( ( $score_song   * $playcount_song   ) + $percent ) / ( $playcount_song + 1 );

        # Now assign new score values to database
        $artistref->{ 'Score' }                     = sprintf( "%.2f", $scored_artist );
        $artistref->{ $album }{ 'Score' }           = sprintf( "%.2f", $scored_album );
        $artistref->{ $album }{ $title }{ 'Score' } = sprintf( "%.2f", $scored_song );

        # If $entry is set, clear it and end loop
        if ( $entry ) {
            $entry = 0;
        } else {
        # Else, save scores to database and print some output.
            $layered{ $artist } = $artistref;
            print "Song Change : \"$title\" ( $album ) by $artist was $percent\% complete.\n";
            print "  Resulting artist score " .  sprintf( "%.2f", $scored_artist ) .  "\n";
            print "  Resulting album score " . sprintf( "%.2f", $scored_album ) .  "\n";
            print "  Resulting song score " . sprintf( "%.2f", $scored_song ) . "\n";
            
            # Only lookup similar artists if artist has changed
            if ( $currentartist ne %songinfo->{ 'Artist' } ) {
               &lastfm_lookup( %songinfo->{ 'Artist' } );
            }

            # Process Last.FM Friends playlists after each song change.
            # Process Last.FM Friends playlists after each song change.
            print "Processing Last.FM Friends ... ";
            &lastfm_friend;

        }

        untie %layered;
        
        $currentsong = %songinfo->{ 'Title' }; # For loop comparison
        $currentartist = %songinfo->{ 'Artist' }; # For loop comparison
        $seconds++;
        $gosa = 0;  # Okay, submission to lastfm for next song okay now.
    } ## end else [ if ( $currentsong eq %songinfo...

} ## end while ( 1 )

exit; # Just in case

sub checkargs {
    my @args    = @_;
    my $numargs = scalar @_;
    my $command = shift( @args );
    my $mpd  = Audio::MPD->new( $mpd_host, $mpd_port );

    if ( $command eq "--build" ) {

        tie my %layered, 'MLDBM', $datafile;
        my @songs = $mpd->listallinfo;
        for my $song ( @songs ) {

            my $album  = $song->{ 'Album' };
            my $genre  = $song->{ 'Genre' };
            my $artist = $song->{ 'Artist' };
            my $title  = $song->{ 'Title' };
            my $date   = $song->{ 'Date' };
            my $time   = $song->{ 'Time' };
            my $track  = $song->{ 'Track' };
            my $file   = $song->{ 'file' };

            my $artistref = $layered{ $artist };

            if ( !$layered{ $artist } ) {
                $artistref->{ 'Played' } = 0;
                $artistref->{ 'Score' }  = 50;
            }

            if ( !$layered{ $artist }{ $album } ) {
                $artistref->{ $album }{ 'Played' } = 0;
                $artistref->{ $album }{ 'Score' }  = 50;
            }

            if ( !$layered{ $artist }{ $album }{ $title } ) {

                $artistref->{ $album }{ $title }{ 'Genre' }  = $genre;
                $artistref->{ $album }{ $title }{ 'Track' }  = $track;
                $artistref->{ $album }{ $title }{ 'Time' }   = $time;
                $artistref->{ $album }{ $title }{ 'File' }   = $file;
                $artistref->{ $album }{ $title }{ 'Played' } = 0;
                $artistref->{ $album }{ $title }{ 'Score' }  = 50;
                $artistref->{ $album }{ $title }{ 'Added' }  = time();

            } ## end if ( !$layered{ $artist...

            $layered{ $artist } = $artistref;
        } ## end for my $song ( @songs )
        untie %layered;

    } elsif ( $command eq "--dump" ) {

        tie my %temp, 'MLDBM', $datafile;
        print Dumper( \%temp );
        untie %temp;
    
    } elsif ( $command eq "--current" ) {
        my %songinfo = $mpd->get_song_info;
        my $artist   = %songinfo->{ 'Artist' };
        my $album    = %songinfo->{ 'Album' };
        my $title    = %songinfo->{ 'Title' };
        tie my %layered, 'MLDBM', $datafile;
        
        print "Artist     : $artist, Score $layered{$artist}{'Score'}";
        if ( $layered{$artist}{'Rank'} ) {
            my $stars = makestars( $layered{$artist}{'Rank'} );
            print ", Rank $stars\n";
        } else {
            print "\n";
        }

        print "Album      : $album, Score $layered{$artist}{$album}{'Score'}";
        if ( $layered{$artist}{$album}{'Rank'} ) {
            my $stars = makestars( $layered{$artist}{$album}{'Rank'} );
            print ", Rank $stars\n";
        } else {
            print "\n";
        }

        print "Title      : $title, Score $layered{$artist}{$album}{$title}{'Score'}";
        if ( $layered{$artist}{$album}{$title}{'Rank'} ) {
            my $stars = makestars( $layered{$artist}{$album}{$title}{'Rank'} );
            print ", Rank $stars\n";
        } else {
            print "\n";
        }
        my $lastplayed = lastplayed( $layered{$artist}{$album}{$title}{ 'Timestamp' }[0] );
        print "LastPlayed : $lastplayed\n";

        untie %layered;
    
    } elsif ( $command eq "--rankup" ) {
        my %songinfo = $mpd->get_song_info;
        my $artist   = %songinfo->{ 'Artist' };
        my $album    = %songinfo->{ 'Album' };
        my $title    = %songinfo->{ 'Title' };
        
        tie my %layered, 'MLDBM', $datafile;
        my $artistref = $layered{ $artist };
        
        $artistref->{'Rank'}++;
        $artistref->{$album}{'Rank'}++;
        $artistref->{$album}{$title}{'Rank'}++;

        print "Artist     : $artist, Score $layered{$artist}{'Score'}";
        if ( $layered{$artist}{'Rank'} ) {
            my $stars = makestars( $layered{$artist}{'Rank'} );
            print ", Rank $stars\n";
        } else {
            print "\n";
        }

        print "Album      : $album, Score $layered{$artist}{$album}{'Score'}";
        if ( $layered{$artist}{$album}{'Rank'} ) {
            my $stars = makestars( $layered{$artist}{$album}{'Rank'} );
            print ", Rank $stars\n";
        } else {
            print "\n";
        }

        print "Title      : $title, Score $layered{$artist}{$album}{$title}{'Score'}";
        if ( $layered{$artist}{$album}{$title}{'Rank'} ) {
            my $stars = makestars( $layered{$artist}{$album}{$title}{'Rank'} );
            print ", Rank $stars\n";
        } else {
            print "\n";
        }
        
        $layered{ $artist } = $artistref;
        untie %layered;

    } elsif ( $command eq "--rankdown" ) {
        my %songinfo = $mpd->get_song_info;
        my $artist   = %songinfo->{ 'Artist' };
        my $album    = %songinfo->{ 'Album' };
        my $title    = %songinfo->{ 'Title' };
        
        tie my %layered, 'MLDBM', $datafile;
        my $artistref = $layered{ $artist };
        $artistref->{$album}{$title}{'Rank'}--;
        $artistref->{$album}{$title}{'Rank'} = 0 if ( $artistref->{$album}{$title}{'Rank'} < 0 );
        $artistref->{$album}{'Rank'}--;
        $artistref->{$album}{'Rank'} = 0 if ( $artistref->{$album}{'Rank'} < 0 );
        $artistref->{'Rank'}--;
        $artistref->{'Rank'} = 0 if ( $artistref->{'Rank'} < 0 );
        
        print "Artist     : $artist, Score $layered{$artist}{'Score'}";
        if ( $layered{$artist}{'Rank'} ) {
            my $stars = makestars( $layered{$artist}{'Rank'} );
            print ", Rank $stars\n";
        } else {
            print "\n";
        }

        print "Album      : $album, Score $layered{$artist}{$album}{'Score'}";
        if ( $layered{$artist}{$album}{'Rank'} ) {
            my $stars = makestars( $layered{$artist}{$album}{'Rank'} );
            print ", Rank $stars\n";
        } else {
            print "\n";
        }

        print "Title      : $title, Score $layered{$artist}{$album}{$title}{'Score'}";
        if ( $layered{$artist}{$album}{$title}{'Rank'} ) {
            my $stars = makestars( $layered{$artist}{$album}{$title}{'Rank'} );
            print ", Rank $stars\n";
        } else {
            print "\n";
        }
        
        $layered{ $artist } = $artistref;
        untie %layered;
    
    } elsif ( $command eq "--getartist" ) {

        my $param = join( ' ', @args );

        searchartist( $param );

    } elsif ( $command eq "--getalbum" ) {

        my $param = join( ' ', @args );

        #printresults( search( 'Album', $param ) );

    } elsif ( $command eq "--gettitle" ) {

        my $param = join( ' ', @args );
        searchtitle( $param );
    
    } elsif ( $command eq "--die" ) {

        # Very nasty, but quick and mostly workable
        my $process = `cat $pidfile`;
        unlink( $pidfile );
        `kill $process`;

    }

    exit;

    sub searchartist {
        my $artistin = join( ' ', @_ );
        tie my %database, 'MLDBM', $datafile;
        print "Artist      : $artistin\n";
        print "Total Plays : $database{ $artistin }{'Played'}\n";
        print "Score       : $database{ $artistin }{'Score'}\n";
        print "Albums      : ";
        while ( my ( $artist, $artisthash ) = each %database ) {
            if ( $artisthash ) {
                if ( $artistin eq $artist ) {
                    while ( my ( $album, $albumhash ) = each %{ $artisthash } ) {
                        print "$album, " unless ( $album =~ /$filter/ );
                    }
                }
            }
        } ## end while ( my ( $artist, $artisthash...
        print "\n";
    } ## end sub searchartist

    sub searchtitle {
        my $insong = @_;
        my $test = join( ' ', @_ );
        my ( @results, %seen );

        tie my %database, 'MLDBM', $datafile;
        while ( my ( $artist, $artisthash ) = each %database ) {
            if ( ( $artisthash ) and ( $artist !~ /$filter/ ) ) {
                while ( my ( $album, $albumhash ) = each %{ $artisthash } ) {
                    if ( ( $albumhash ) and ( $album !~ /$filter/ ) ) {
                        while ( my ( $song, $songhash ) = each %{ $albumhash } ) {
                            if ( $songhash ) {
                                if ( $song eq $test ) {
                                    my %record;
                                    $record{ 'Album' }  = $album;
                                    $record{ 'Genre' }  = $songhash->{ 'Genre' };
                                    $record{ 'Artist' } = $artist;
                                    $record{ 'Title' }  = $song;
                                    $record{ 'Played' } = $songhash->{ 'Played' };
                                    $record{ 'Score' }  = $songhash->{ 'Score' };
                                    $record{ 'Rank' }   = $songhash->{ 'Rank' };
                                    my $blurb = \%record;
                                    push( @results, $blurb ) unless ( $seen{ %record }++ );
                                } ## end if ( $song eq $test )
                            } ## end if ( $songhash )
                        } ## end while ( my ( $song, $songhash...
                    } ## end if ( ( $albumhash ) and...
                } ## end while ( my ( $album, $albumhash...
            } ## end if ( ( $artisthash ) and...
        } ## end while ( my ( $artist, $artisthash...

        foreach my $result ( @results ) {
            print "Album  : $result->{'Album'}\n";
            print "Genre  : $result->{'Genre'}\n";
            print "Artist : $result->{'Artist'}\n";
            print "Title  : $result->{'Title'}\n";
            print "Plays  : $result->{'Played'}\n" if $result->{ 'Played' };
            print "Plays  : 0\n" unless $result->{ 'Played' };
            print "Score  : $result->{'Score'}\n";
            if ( ! $result->{'Rank'} ) {
                print "Rank   : Unranked\n";
            } else {
                print "Rank   : ";
                my ( $counter );
                while ( $counter < $result->{'Rank'} ) {
                    $counter++;
                    print "*";
                }
                print " ( $result->{'Rank'} ) \n";
                print "\n";
            }
        } ## end foreach my $result ( @results)
    } ## end sub searchtitle

} ## end sub checkargs

sub makestars {
    my ( $rank ) = @_;
    my ( $counter, $string );
    $string .= "$rank ";
    while ( $counter < $rank ) {
        $counter++;
        $string .= "*";
    }
    return $string;
}        

sub lastplayed {
    my $time = shift;
    my ( $second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings ) = localtime($time);
    my $year = $yearOffset + 1900;
    my $returned = $month . "/" . $dayOfMonth . "/" . $year . " " . $hour . ":" . $minute . ":" . $second;
    if ( $returned eq "11/31/1969 16:0:0") {
        return "Never";
    } else {
        return $returned;
    }
}

sub update_playlists {
    my ( @results, @played50, @score50, @ranked50, @last50, @added50 );

    # There has GOT to be a better way than this... <sigh>
    tie my %database, 'MLDBM', $datafile;
    while ( my ( $artist, $artisthash ) = each %database ) {
        if ( ( $artisthash ) and ( $artist !~ /$filter/ ) ) {
            while ( my ( $album, $albumhash ) = each %{ $artisthash } ) {
                if ( ( $albumhash ) and ( $album !~ /$filter/ ) ) {
                    while ( my ( $song, $songhash ) = each %{ $albumhash } ) {
                        if ( ( $songhash ) and ( $song !~ /$filter/ ) ) {
                            my %record;
                            $record{ 'File' }        = $songhash->{ 'File' };
                            $record{ 'Played' }      = $songhash->{ 'Played' };
                            $record{ 'Score' }       = $songhash->{ 'Score' };
                            $record{ 'Rank' }        = $songhash->{ 'Rank' };
                            $record{ 'Added' }       = $songhash->{ 'Added' };
                            $record{ 'Timestamp' }   = $songhash->{ 'Timestamp' };
                            my $blurb = \%record;
                            push( @results, \%record );
                        }
                    } ## end while ( my ( $song, $songhash...
                } ## end if ( ( $albumhash ) and...
            } ## end while ( my ( $album, $albumhash...
        } ## end if ( ( $artisthash ) and...
    } ## end while ( my ( $artist, $artisthash...
    untie %database;
   
    my @played = sort { $b->{ 'Played' }       <=> $a->{ 'Played' }       } @results;
    my @score  = sort { $b->{ 'Score' }        <=> $a->{ 'Score' }        } @results;
    my @ranked = sort { $b->{ 'Rank' }         <=> $a->{ 'Rank' }         } @results;
    my @added  = sort { $b->{ 'Added' }        <=> $a->{ 'Added' }        } @results;
    my @last   = sort { $b->{ 'Timestamp' }[0] <=> $a->{ 'Timestamp' }[0] } @results;

    # Prime arrays
    my ( $counter100, @listof100 );
    while ( $counter100 < 100 ) {
        push (@listof100, $counter100++ );
    }
    my ( $counter50, @listof50 );
    while ( $counter50 < 50 ) {
        push (@listof50, $counter50++ );
    }

    # Sometimes we get blanklines (dunno why), so filter em out.
    for my $index ( @listof100 ) {
        push( @played50, $played[$index]->{ 'File' } ) if ( $played[$index]->{ 'File' } );
        push( @score50, $score[$index]->{ 'File' } ) if ( $score[$index]->{ 'File' } );
        push( @ranked50, $ranked[$index]->{ 'File' } ) if ( $ranked[$index]->{ 'File' } );
        push( @last50, $last[$index]->{ 'File' } ) if ( $last[$index]->{ 'File' } );
        push( @added50, $added[$index]->{ 'File' } ) if ( $added[$index]->{ 'File' } );
    }
    
    # Write out playlists
    open( SCORE50, "> $scored50_playlist" );
    open( PLAY50, "> $played50_playlist" );
    open( RANK50, "> $ranked50_playlist" );
    open( LAST50, "> $last50_playlist" );
    open( ADD50, "> $add50_playlist" );
    for my $index ( @listof50 ) {
        print SCORE50 "$score50[$index]\n";
        print PLAY50 "$played50[$index]\n";
        print RANK50 "$ranked50[$index]\n";
        print LAST50 "$last50[$index]\n";
        print ADD50 "$added50[$index]\n";
    }
    close SCORE50;
    close PLAY50;
    close RANK50;
    close LAST50;
    close ADD50;
    
} ## end sub update_playlists

sub lastfm_friend {
    my @allresults;

    my %friendhash;

    # Preclare user arrays
    for my $friend ( @friends ) {
        $friendhash{ $friend } = [ ];
    }
    for my $friend ( @friends ) {

        my $fetch = $lastfm_base_url . $friend . $lastfm_base_suffix;
        #print "Fetching $fetch\n";
        my $url2parse = get( $fetch );
        my $rss = new XML::RSS;
        $rss->parse( $url2parse );

        tie my %database, 'MLDBM', $datafile;
        foreach my $item (@{$rss->{'items'}}) {
            next unless defined($item->{'title'});
            my ( $lastfm_artist, $lastfm_song ) = split('\x{2013}', $item->{'title'} );
            $lastfm_song   =~ s/^\s+//; # Drop leading whitespace
            $lastfm_artist =~ s/\s+$//; # Drop trailing whitespace

            while ( my ( $artist, $artisthash ) = each %database ) {
                if ( ( $artisthash ) and ( $artist !~ /$filter/ ) and ( $artist eq $lastfm_artist ) ) {
                    while ( my ( $album, $albumhash ) = each %{ $artisthash } ) {
                        if ( ( $albumhash ) and ( $album !~ /$filter/ ) ) {
                            while ( my ( $song, $songhash ) = each %{ $albumhash } ) {
                                if ( ( $songhash ) and ( $song !~ /$filter/ ) and ( $song eq $lastfm_song ) ) {
                                    push( @{ $friendhash{ $friend } }, $songhash->{ 'File' } );
                                    push( @{ $friendhash{ 'Friends' } }, $songhash->{ 'File' } );
                                }
                            } ## end while ( my ( $song, $songhash...
                        } ## end if ( ( $albumhash ) and...
                    } ## end while ( my ( $album, $albumhash...
                } ## end if ( ( $artisthash ) and...
            }
            # print "$lastfm_artist->{'name'}\n" if ( $lastfm_artist->{'match'} > 83 );


        }
        untie %database;
    }

    while ( my ( $buddy, $buddyhash ) = each %friendhash ) {
        
        # Read in old playlist (if any )
        my @oldplaylist;
        if ( -e $playlist_dir . "/LastFM_" . $buddy ) {
            open( LASTFMBUD, "< " . $playlist_dir . "/LastFM_" . $buddy . ".m3u"  );
            @oldplaylist = <LASTFMBUD>;
            close LASTFMBUD;
        }

        # If old playlist is larger that 50 items, trim.
        my $oldplaylist_size = scalar @oldplaylist;
        while ( $oldplaylist_size > 50 ) {
            pop( @oldplaylist );
            $oldplaylist_size = scalar @oldplaylist
        }
        
        # Merge old and new playlists.
        my @unsorted = ( @{ $buddyhash }, @oldplaylist );

        # Remove Dupes
        my %seen = ();
        my @unique_results = grep { ! $seen{$_} ++ } @unsorted;

        # And write the playlist
        open( LASTFMBUD, "> " . $playlist_dir . "/LastFM_" . $buddy . ".m3u"  );
        for my $result ( @unique_results ) {
            print LASTFMBUD "$result\n";
        }
        close LASTFMBUD;
    }

    close LASTFM;
    print "Done\n";
}


sub lastfm_lookup {
    my $lookuptext = join( ' ', @_ );
    print "Looking up \"$lookuptext\" on Last.FM for similar artists\n";
    
    my @similar = $sa->lookup($lookuptext);
    my @results;

    tie my %database, 'MLDBM', $datafile;
    
    for my $lastfm_artist ( @similar ) {
   
        while ( my ( $artist, $artisthash ) = each %database ) {
            if ( ( $artisthash ) and ( $artist !~ /$filter/ ) and ( ( $artist eq $lastfm_artist->{'name'} ) or ( $artist eq $lookuptext ) ) ) {
                while ( my ( $album, $albumhash ) = each %{ $artisthash } ) {
                    if ( ( $albumhash ) and ( $album !~ /$filter/ ) ) {
                        while ( my ( $song, $songhash ) = each %{ $albumhash } ) {
                            if ( ( $songhash ) and ( $song !~ /$filter/ ) ) {
                                push( @results, $songhash->{ 'File' } );
                            }
                        } ## end while ( my ( $song, $songhash...
                    } ## end if ( ( $albumhash ) and...
                } ## end while ( my ( $album, $albumhash...
            } ## end if ( ( $artisthash ) and...
        }
        # print "$lastfm_artist->{'name'}\n" if ( $lastfm_artist->{'match'} > 83 );
    }
    untie %database;

    my %seen = ();
    my @unique_results = grep { ! $seen{$_} ++ } @results;    
    
    # Write out Similar playlist
    open( LASTFM, "> $lastfm_similar" );
    for my $result ( @unique_results ) {
        print LASTFM "$result\n";
    }
    close LASTFM;
}

sub lastfm_submit {
    my ( $details ) = @_;
  return undef if ( ( ! $details->{'length'} ) or ( ! $details->{'artist'} ) or ( ! $details->{'album'} ) or ( ! $details->{'title'} ) );
   
    my @t = gmtime(); 
    my $datestr = sprintf('%04d-%02d-%02d %02d:%02d:%02d', $t[5] + 1900, $t[4] + 1, @t[3, 2, 1, 0]);
    my %info = (
        title => encode("UTF-8", $details->{'title'} ),
        album => encode("UTF-8", $details->{'album'} ),
        artist => encode("UTF-8", $details->{'artist'} ),
        length => encode("UTF-8", $details->{'length'} ),
        timestamp => $datestr
    );
  
  return \%info;
} 

sub lastfm_flush {
    my @inqueue = @_;
    my @outqueue;

    for my $item ( @inqueue ) {
        next if ( ! $item );

        print "Submitting  : \"$item->{'title'}\" ( $item->{'album'} ) by $item->{'artist'}, Length $item->{'length'}, Timestamp $item->{'timestamp'}, to Last.FM\n";

        my %submit = (
            title => $item->{'title'},
            album => $item->{'album'},
            artist => $item->{'artist'},
            length => $item->{'length'},
            timestamp => $item->{'timestamp'}
        );

        # Create a Last.FM Submission configuration
        my $scrob = Audio::Scrobbler->new( 'cfg' => \%lastfm_submit ) or die "Could not create an Audio::Scrobbler object\n";

        # fork
        my $handshake = $scrob->handshake;
        #
        if ( $handshake ) {
            my $submit_status = $scrob->submit( \%submit );

            if (! $submit_status ) {
                my $submit_error = $scrob->err;
                print "SUBMIT ERROR: $submit_error\n";
                push ( @outqueue, \%submit );
            }

        } else {
            my $handshake_error = $scrob->err;
            print "Handshake ERROR : $handshake_error\n";
            push ( @outqueue, \%submit );
        }
    }

}

# Custom included version, modified to support backdating on
# submit requests...

package Audio::Scrobbler;

use 5.006;
use strict;
use bytes;

=head1 NAME

Audio::Scrobbler - Perl interface to audioscrobbler.com/last.fm

=head1 SYNOPSIS

  use Audio::Scrobbler;

  $scrob = new Audio::Scrobbler(cfg => { ... });

  $scrob->handshake();
  $scrob->submit(artist => "foo", album => "hello", track => "world",
    length => 180);

=head1 DESCRIPTION

The C<Audio::Scrobbler> module provides a Perl interface to the track
submission API of Last.fm's AudioScrobbler -
http://www.audioscrobbler.com/.  So far, only track submissions are
handled; the future plans include access to the various statistics.

=cut

use Digest::MD5 qw/md5_hex/;
use LWP::UserAgent;

our @ISA = qw();

our $VERSION = '0.01';

sub err($ $);
sub handshake($);

sub get_ua($);

sub URLEncode($);
sub URLDecode($);

=head1 METHODS

The C<Audio::Scrobbler> class defines the following methods:

=over 4

=item * new ( cfg => { ... } )

Create a new C<Audio::Scrobbler> object and initialize it with
the provided configuration parameters.  The parameters themselves
are discussed in the description of the L<handshake> and L<submit>
methods below.

=cut

sub new
{
	my $proto = shift;
	my $class = ref $proto || $proto;
	my $self = { };
	my %args = @_;

	if (exists($args{'cfg'}) && ref $args{'cfg'} eq 'HASH') {
		$self->{'cfg'} = $args{'cfg'};
	} else {
		$self->{'cfg'} = { };
	}
	$self->{'cfg'} = $args{'cfg'} || { };
	$self->{'ua'} = undef;
	$self->{'req'} = { };
	$self->{'err'} = undef;
	bless $self, $class;
	return $self;
}

=item * err (message)

Retrieves or sets the description of the last error encountered in
the operation of this C<Audio::Scrobbler> object.

=cut

sub err($ $)
{
	my ($self, $err) = @_;

	$self->{'err'} = $err if $err;
	return $self->{'err'};
}

=item * handshake ()

Perfors a handshake with the AudioScrobbler API via a request to
http://post.audioscrobbler.com/.

This method requires that the following configuration parameters be set:

=over 4

=item * progname

The name of the program (or plug-in) performing the AudioScrobbler handshake.

=item * progver

The version of the program (or plug-in).

=item * username

The username of the user's AudioScrobbler registration.

=back

If the handshake is successful, the method returns a true value, and
the L<submit> method may be invoked.  Otherwise, an appropriate error
message may be retrieved via the L<err> method.

If the B<fake> configuration parameter is set, the L<handshake> method
does not actually perform the handshake with the AudioScrobbler API,
just simulates a successful handshake and returns a true value.

If the B<verbose> configuration parameter is set, the L<handshake>
method reports its progress with diagnostic messages to the standard output.

=cut

sub handshake($)
{
	my ($self) = @_;
	my ($ua, $req, $resp, $c, $s);
	my (@lines);

	delete $self->{'nexturl'};
	delete $self->{'md5ch'};

	$ua = $self->get_ua() or return undef;
	$s = 'hs=true&p=1.1&c='.
	    URLEncode($self->{'cfg'}{'progname'}).'&v='.
	    URLEncode($self->{'cfg'}{'progver'}).'&u='.
	    URLEncode($self->{'cfg'}{'username'});
	print "RDBG about to send the handshake request: $s\n"
	    if $self->{'cfg'}{'verbose'};
	if ($self->{'cfg'}{'fake'}) {
		print "RDBG faking it...\n" if $self->{'cfg'}{'verbose'};
		$self->{'md5ch'} = 'furrfu';
		$self->{'nexturl'} = 'http://furrfu.furrblah/furrquux';
		return 1;
	}
	$req = new HTTP::Request('GET', "http://post.audioscrobbler.com/?$s");
	if (!$req) {
		$self->err('Could not create the handshake request object');
		return undef;
	}
	$resp = $ua->request($req);
	print "RDBG resp is $resp, success is ".$resp->is_success()."\n"
	    if $self->{'cfg'}{'verbose'};
	if (!$resp) {
		$self->err('Could not get a handshake response');
		return undef;
	} elsif (!$resp->is_success()) {
		$self->err('Could not complete the handshake: '.
		    $resp->status_line());
		return undef;
	}
	$c = $resp->content();
	print "RDBG resp content is:\n$c\nRDBG ====\n"
	    if $self->{'cfg'}{'verbose'};
	@lines = split /[\r\n]+/, $c;
	$_ = $lines[0];
SWITCH:
	{
		/^FAILED\s+(.*)/ && do {
			$self->err("Could not complete the handshake: $1");
			return undef;
		};
		/^BADUSER\b/ && do {
			$self->err('Could not complete the handshake: invalid username');
			return undef;
		};
		/^UPTODATE\b/ && do {
			$self->{'md5ch'} = $lines[1];
			$self->{'nexturl'} = $lines[2];
			last SWITCH;
		};
		/^UPDATE\s+(.*)/ && do {
			# See if we care. (FIXME)
			$self->{'md5ch'} = $lines[1];
			$self->{'nexturl'} = $lines[2];
			last SWITCH;
		};
		$self->err("Unrecognized handshake response: $_");
		return undef;
	}
	print "RDBG MD5 challenge '$self->{md5ch}', nexturl '$self->{nexturl}'\n"
	    if $self->{'cfg'}{'verbose'};
	return 1;
}

=item * submit ( info )

Submits a single track to the AudioScrobbler API.   This method may only
be invoked after a successful L<handshake>.  The track information is
contained in the hash referenced by the B<info> parameter; the following
elements are used:

=over 4

=item * title

The track's title.

=item * artist

The name of the artist performing the track.

=item * length

The duration of the track in seconds.

=item * album

The name of the album (optional).

=back

Also, the L<submit> method requires that the following configuration
parameters be set for this C<Audio::Scrobbler> object:

=over 4

=item * username

The username of the user's AudioScrobbler registration.

=item * password

The password for the AudioScrobbler registration.

=back

If the submission is successful, the method returns a true value.
Otherwise, an appropriate error message may be retrieved via the L<err>
method.

If the B<fake> configuration parameter is set, the L<submit> method
does not actually submit the track information to the AudioScrobbler API,
just simulates a successful submission and returns a true value.

If the B<verbose> configuration parameter is set, the L<submit>
method reports its progress with diagnostic messages to the standard output.

=cut

sub submit($ \%)
{
	my ($self, $info) = @_;
	my ($ua, $req, $resp, $s, $c, $datestr, $md5resp);
	my (@t, @lines);

	# A couple of sanity checks - those never hurt
	if (!defined($self->{'nexturl'}) || !defined($self->{'md5ch'})) {
		$self->err('Cannot submit without a successful handshake');
		return undef;
	}

	if (!defined($info->{'title'}) || !defined($info->{'album'}) ||
	    !defined($info->{'artist'}) || !defined($info->{'length'}) ||
	    $info->{'length'} !~ /^\d+$/) {
		$self->err('Missing or incorrect submission info fields');
		return undef;
	}
    # If we are passed a timestamp, use it - else just use now.
    if (! defined ( $info->{'timestamp'} ) ) {
	    @t = gmtime();
	    $datestr = sprintf('%04d-%02d-%02d %02d:%02d:%02d', $t[5] + 1900, $t[4] + 1, @t[3, 2, 1, 0]);
    } else {
        $datestr = $info->{'timestamp'};
    }

	# Init...
	# Let's hope md5_hex() always returns lowercase hex stuff
	$md5resp = md5_hex(
	    md5_hex($self->{'cfg'}{'password'}).$self->{'md5ch'});

	# Let's roll?
	$req = HTTP::Request->new('POST', $self->{'nexturl'});
	if (!$req) {
		$self->err('Could not create the submission request object');
		return undef;
	}
	$req->content_type('application/x-www-form-urlencoded; charset="UTF-8"');
	$s = 'u='.URLEncode($self->{'cfg'}{'username'}).
	    "&s=$md5resp&a[0]=".URLEncode($info->{'artist'}).
	    '&t[0]='.URLEncode($info->{'title'}).
	    '&b[0]='.URLEncode($info->{'album'}).
	    '&m[0]='.
	    '&l[0]='.$info->{'length'}.
	    '&i[0]='.URLEncode($datestr).
	    "\r\n";
	$req->content($s);
	print "RDBG about to send a submission request:\n".$req->content().
	    "\n===\n" if $self->{'cfg'}{'verbose'};
	if ($self->{'cfg'}{'fake'}) {
		print "RDBG faking it...\n" if $self->{'cfg'}{'verbose'};
		return 1;
	}

	$ua = $self->get_ua() or return undef;
	$resp = $ua->request($req);
	if (!$resp) {
		$self->err('Could not get a submission response object');
		return undef;
	} elsif (!$resp->is_success()) {
		$self->err('Could not complete the submission: '.
		    $resp->status_line());
		return undef;
	}
	$c = $resp->content();
	print "RDBG response:\n$c\n===\n" if $self->{'cfg'}{'verbose'};
	@lines = split /[\r\n]+/, $c;
	$_ = $lines[0];
SWITCH:
	{
		/^OK\b/ && last SWITCH;
		/^FAILED\s+(.*)/ && do {
			$self->err("Submission failed: $1");
			return undef;
		};
		/^BADUSER\b/ && do {
			$self->err('Incorrest username or password');
			return undef;
		};
		$self->err('Unrecognized submission response: '.$_);
		return undef;
	}
	print "RDBG submit() just fine and dandy!\n"
	    if $self->{'cfg'}{'verbose'};
	return 1;
}

=back

There are also several methods and functions for the module's internal
use:

=over 4

=item * get_ua ()

Creates or returns the cached C<LWP::UserAgent> object used by
the C<Audio::Scrobbler> class for access to the AudioScrobbler API.

=cut

sub get_ua($)
{
	my ($self) = @_;
	my ($ua);

	$self->{'ua'} ||= new LWP::UserAgent();
	if (!$self->{'ua'}) {
		$self->err('Could not create a LWP UserAgent object');
		return undef;
	}
	$self->{'ua'}->agent('scrobbler-helper/1.0pre1 '.
	    $self->{'ua'}->_agent());
	return $self->{'ua'};
}

=item * URLDecode (string)

Decode a URL-encoded string.

Obtained from http://glennf.com/writing/hexadecimal.url.encoding.html

=cut

sub URLDecode($) {
	my $theURL = $_[0];
	$theURL =~ tr/+/ /;
	$theURL =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg;
	$theURL =~ s/<!--(.|\n)*-->//g;
	return $theURL;
}

=item * URLEncode (string)

Return the URL-encoded representation of a string.

Obtained from http://glennf.com/writing/hexadecimal.url.encoding.html

=cut

sub URLEncode($) {
	my $theURL = $_[0];
	$theURL =~ s/([^a-zA-Z0-9_])/'%' . uc(sprintf("%2.2x",ord($1)));/eg;
	return $theURL;
}

=back

=head1 TODO

=over 4

=item *

Do something with UPDATE responses to the handshake.

=item *

Honor INTERVAL in some way.

=item *

Figure out a way to cache unsuccesful submissions for later retrying.

=item *

Web services - stats!

=back

=head1 SEE ALSO

B<scrobbler-helper(1)>

=over 4

=item * http://www.last.fm/

=item * http://www.audioscrobbler.com/

=item * http://www.audioscrobbler.net/

=back

The home site of the C<Audio::Scrobbler> module is
http://devel.ringlet.net/audio/Audio-Scrobbler/

=head1 AUTHOR

Peter Pentchev, E<lt>roam@ringlet.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005, 2006 by Peter Pentchev.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.7 or,
at your option, any later version of Perl 5 you may have available.

$Id: Scrobbler.pm 88 2006-01-02 09:16:32Z roam $

=cut

1;
